perm filename SUBGOA[P,JRA] blob sn#137083 filedate 1974-12-20 generic text, type T, neo UTF8

(DEFPROP SUBGOALCOND 
 (LAMBDA(PRE DF)
  (PROG (PC LI SW SWR SG SR LIT)
	(SETQ PC PRE)
	(COND ((NULL PC) (RETURN NIL)))
   SU1  (SETQ SW NIL)
	(SETQ LI (CAAR PC))
	(SETQ SWR NIL)
	(COND
	 ((AND DF (NOT (ATOM (CAR LI)))) (SETQ SG
					       (CONS (CONS (QUOTE THAND)
							   (APPEND (REJECTQUIK LI NIL)
								   (CSG (SUBGOALCOND LI NIL))))
 						     SG))
					 (GO SU7)))
	(COND ((NOT (EQ LI (QUOTE *))) (GO SU15)))
	(SETQ SG (CONS (ITERATE (CAR PC)) SG))
	(GO SU7)
   SU15 (COND ((NULL (CDAR PC)) (GO SU2)))
	(SETQ SG (CONS (DISJUN (CAR PC)) SG))
	(GO SU7)
   SU2  (COND ((NOT (EQ (QUOTE REQUEST) (CAR LI))) (GO SU21)))
	(SETQ SWR T)
	(SETQ LI (CDR LI))
	(COND ((EQ NEGSGN (CAR (EXPLODE (CAR LI))))
	       (SETQ LI (APPEND (LIST NEGSGN (READLIST (CDR (EXPLODE (CAR LI))))) (CADR LI))))
	      (T (SETQ LI (CONS (CAR LI) (CADR LI)))))
   SU21 (COND ((EQ NEGSGN (CAR LI)) (SETQ SW T)))
	(COND
	 ((AND SWR (NOT (COND (SW (GET (CADR LI) (QUOTE FLUENT))) (T (GET (CAR LI) (QUOTE FLUENT))))))
	  (SETQ SG (CONS (CAR (REJECTQUIK (LIST (LIST LI)) NIL)) SG))))
	(COND (SW (SETQ LI (CDR LI))))
	(COND
	 ((NOT (OR (GET (CAR LI) (QUOTE SUBR)) (GET (CAR LI) (QUOTE EXPR)) (GET (CAR LI) (QUOTE FEXPR))))
	  (GO SU23)))
	(SETQ SG (CONS (COND (SW (LIST (QUOTE NOT) (PLPRED LI T))) (T (PLPRED LI T))) SG))
	(GO SU7)
   SU23 (COND ((NOT (GET (CAR LI) (QUOTE FLUENT))) (GO SU7)))
	(COND
	 ((EQ (QUOTE =) (CAR LI)) (SETQ SG
					(CONS (LIST (QUOTE THCOND)
						    (LIST (LIST (QUOTE THASVAL) (CADR (PLPRED LI T)))
							  (CONS (QUOTE EQUAL) (CDR (PLPRED LI T))))
						    (LIST T
							  (LIST (QUOTE THSETQ)
								(CADR (PLPRED LI T))
								(CADDR (PLPRED LI T)))))
 					      SG))
				  (GO SU7)))
	(COND ((NOT (GET (CAR LI) (QUOTE UNCERT))) (GO SU3)))
	(SETQ SG
	      (CONS (LIST (QUOTE THCOND)
			  (LIST (THANDVAL LI)
				(LIST (QUOTE UNCERTLIT)
				      (APPEND (QUOTE (LIST))
					      (CONS (COND (SW
							   (LIST (QUOTE QUOTE)
								 (READLIST
								  (APPEND (QUOTE (N)) (EXPLODE (CAR LI))))))
							  (T (LIST (QUOTE QUOTE) (CAR LI))))
						    (APPEND (CDR (PLPRED LI NIL)) (QUOTE ((QUOTE R))))))
 				      DF
				      (QUOTE X)
				      (QUOTE Y)))
			  (QUOTE (T T)))
 		    SG))
	(COND ((NULL DF) (SETQ SG (CONS (LIST (QUOTE CONDSTAT) (QUOTE (THV CGL)) DF) SG))))
	(GO SU7)
   SU3  (COND ((AND (NOT (GET (CAR LI) (QUOTE PARTIAL))) SW) (GO SU11)))
	(COND
	 ((NOT (GET (CAR LI) (QUOTE PARTIAL))) (SETQ SG
						     (CONS (APPEND (LIST (QUOTE THGOAL)
									 (APPEND (PLPRED LI NIL) (QUOTE (R))))
								   (COND (SWR NIL)
									 (T (LIST (QUOTE (THTBF FILTEROP))))))
 							   SG))
					       (GO SU5)))
	(SETQ LIT LI)
	(COND (SW (SETQ LI (CONS (READLIST (APPEND (QUOTE (N)) (EXPLODE (CAR LI)))) (CDR LI))))
	      (T (SETQ LIT (CONS (READLIST (APPEND (QUOTE (N)) (EXPLODE (CAR LI)))) (CDR LI)))))
	(SETQ SG
	      (CONS (LIST (QUOTE THCOND)
			  (LIST (APPEND (LIST (QUOTE THGOAL) (APPEND (PLPRED LI NIL) (QUOTE (R))))
					(COND (SWR NIL) (T (LIST (QUOTE (THTBF FILTEROP))))))
 				T)
			  (LIST (LIST (QUOTE THGOAL) (APPEND (PLPRED LIT NIL) (QUOTE (R)))) (QUOTE (THFAIL)))
			  (LIST T
				(LIST (QUOTE UNCERTLIT)
				      (APPEND (QUOTE (LIST))
					      (CONS (LIST (QUOTE QUOTE) (CAR LI))
						    (APPEND (CDR (PLPRED LI NIL)) (QUOTE ((QUOTE R))))))
 				      DF
				      (LIST (QUOTE QUOTE) (APPEND (PLPRED LI NIL) (QUOTE (R))))
				      (LIST (QUOTE QUOTE) (APPEND (PLPRED LIT NIL) (QUOTE (R)))))))
 		    SG))
	(COND ((NULL DF) (SETQ SG (CONS (LIST (QUOTE CONDSTAT) (QUOTE (THV CGL)) DF) SG))))
   SU5  (COND ((OR (GET OP (QUOTE AX)) SWR) (GO SU7)))
	(COND
	 ((EQUAL (QUOTE (C P)) (LIST (CAR (EXPLODE (CAR LI))) (CADR (EXPLODE (CAR LI)))))
	  (SETQ LI (CONS (QUOTE C) (CDR LI)))))
	(SETQ SG
	      (CONS (LIST (QUOTE THCOND)
			  (LIST (THANDVAL LI)
				(LIST (QUOTE THSETQ)
				      (LIST (QUOTE THV)
					    (READLIST
					     (APPEND (EXPLODE (CAR LI))
						     (LIST (QUOTE A) (QUOTE R) (QUOTE G) (QUOTE S)))))
				      (LIST (QUOTE CONS)
					    (CONS (QUOTE LIST) (CDR (PLPRED LI T)))
					    (LIST (QUOTE THV)
						  (READLIST
						   (APPEND (EXPLODE (CAR LI))
							   (LIST (QUOTE A) (QUOTE R) (QUOTE G) (QUOTE S))))))))
			  (LIST T T))
 		    SG))
	(COND (DF (SETQ SG (CONS (LIST (QUOTE THAND) (CADR SG) (CAR SG)) (CDDR SG)))))
	(SETQ SR
	      (CONS (LIST (QUOTE THCOND)
			  (LIST (LIST (QUOTE NULL)
				      (LIST (QUOTE THV)
					    (READLIST
					     (APPEND (EXPLODE (CAR LI))
						     (LIST (QUOTE A) (QUOTE R) (QUOTE G) (QUOTE S))))))
 				T)
			  (LIST T
				(LIST (QUOTE THSETQ)
				      (LIST (QUOTE THV)
					    (READLIST
					     (APPEND (EXPLODE (CAR LI))
						     (LIST (QUOTE A) (QUOTE R) (QUOTE G) (QUOTE S)))))
				      (LIST (QUOTE CDR)
					    (LIST (QUOTE THV)
						  (READLIST
						   (APPEND (EXPLODE (CAR LI))
							   (LIST (QUOTE A) (QUOTE R) (QUOTE G) (QUOTE S))))))
 				      T
 				      T)))
 		    SR))
	(COND
	 (DF
	  (SETQ SR
		(CONS (LIST (QUOTE THCOND)
			    (LIST (LIST (QUOTE THGOAL) (APPEND (PLPRED LI NIL) (LIST (QUOTE R)))) (CAR SR))
			    (LIST T T))
		      (CDR SR)))))
   SU7  (SETQ PC (CDR PC))
	(COND ((NOT (NULL PC)) (GO SU1)))
   SU9  (RETURN (CONS (REVERSE SG) SR))
   SU11 (SETQ SG
	      (CONS (LIST (QUOTE THCOND)
			  (LIST (LIST (QUOTE THNOT)
				      (LIST (QUOTE THGOAL) (APPEND (PLPRED LI NIL) (LIST (QUOTE R)))))
 				T)
			  (LIST T
				(LIST (QUOTE THGOAL)
				      (APPEND (PLPRED (CONS NEGSGN LI) NIL) (LIST (QUOTE R)))
				      (QUOTE (THTBF FILTEROP)))))
 		    SG))
	(SETQ LI (CONS (READLIST (APPEND (LIST (QUOTE N)) (EXPLODE (CAR LI)))) (CDR LI)))
	(GO SU5))) 
EXPR)